home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / GFXFX2.ZIP / SCALE.PAS < prev    next >
Pascal/Delphi Source File  |  1995-02-14  |  3KB  |  103 lines
  1.  
  2. program scale; { SCALE.PAS }
  3. { Scale and mirror bitmap demo, by Bas van Gaalen }
  4. uses u_vga,u_ffpcx,u_pal,u_kb;
  5. const
  6.   dir:shortint=3;
  7.   ptab:array[0..255] of byte=(
  8.     123,121,119,117,115,114,112,110,108,106,104,103,101,99,97,96,94,92,91,
  9.     89,87,86,84,82,81,79,78,76,75,73,72,70,69,67,66,64,63,62,60,59,58,56,
  10.     55,54,52,51,50,49,48,46,45,44,43,42,41,39,38,37,36,35,34,33,32,31,30,
  11.     29,28,27,26,26,25,24,23,22,21,21,20,19,18,17,17,16,15,15,14,13,13,12,
  12.     12,11,10,10,9,9,8,8,7,7,6,6,5,5,5,4,4,4,3,3,3,2,2,2,2,1,1,1,1,1,1,0,0,
  13.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,5,5,6,6,
  14.     7,7,7,8,8,9,9,10,11,11,12,12,13,14,14,15,16,16,17,18,19,19,20,21,22,
  15.     23,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,
  16.     46,47,48,49,51,52,53,54,56,57,58,60,61,62,64,65,67,68,69,71,72,74,75,
  17.     77,78,80,82,83,85,86,88,90,91,93,95,96,98,100,102,103,105,107,109,111,
  18.     113,114,116,118,120,122,124,126);
  19.  
  20. var
  21.   stab:array[0..255] of shortint;
  22.   pcxpal:pal_type;
  23.   pcxpic,virscr:pointer;
  24.   xobj,i,virseg:word;
  25.   vx,vy,vx2,vy2, { virtual }
  26.   x,y,x2,y2, { real }
  27.   px,py,px2,py2:integer; { previous }
  28.   pidx,j,k:byte;
  29.  
  30. begin
  31.   getmem(pcxpic,64000);
  32.   if pcx_load(paramstr(1),pcxpic,pcxpal)<>pcx_ok then begin
  33.     writeln('An error ocured: ',pcx_errstr); halt; end;
  34.   setvideo($13);
  35.   setpal(pcxpal);
  36.  
  37.   getmem(virscr,64000); cls(virscr,64000); virseg:=seg(virscr^);
  38.   destenation:=virscr; { destenation is now virtual screen }
  39.  
  40.   { bump'n'scale picture }
  41.   pidx:=128; px:=0; py:=0; px2:=0; py2:=0; vx:=10;
  42.   repeat
  43.     vga_fill(px,py,px2,py2,0); { clear old pos }
  44.     if (vx<-50) or (vx>260) then dir:=-dir; { calculate virtual positions }
  45.     vy:=25+ptab[pidx]; vy2:=vy+100; inc(pidx,4);
  46.     if vy2<200 then inc(vx,dir);
  47.     vx2:=vx+100;
  48.     x:=vx; if x<0 then x:=0; { derive screen positions }
  49.     x2:=vx2; if x2>319 then x2:=319;
  50.     y:=vy;
  51.     y2:=vy2; if y2>199 then y2:=199;
  52.     px:=x; px2:=x2; py:=y; py2:=y2; { set previous coords }
  53.     vretrace;
  54.     scalepic(pcxpic,320,200,x,y,x2,y2); { draw scaled picture on virscreen }
  55.     flip(virscr,vidptr,64000);
  56.   until keypressed;
  57.   clearkeybuf;
  58.  
  59.   { rotate pictures, vertical and horizontal }
  60.   cls(virscr,64000);
  61.   cls(vidptr,64000);
  62.   for j:=0 to 255 do stab[j]:=round(cos(2*pi*j/255)*50);
  63.   k:=128;
  64.   repeat
  65.     vga_fill(40,50,280,150,0);
  66.     scalepic(pcxpic,320,200,40,100-stab[j],140,100+stab[j]);
  67.     scalepic(pcxpic,320,200,230-stab[k],50,230+stab[k],150);
  68.     flip(ptr(virseg,50*320),ptr($a000,50*320),150*320);
  69.     inc(j,3); inc(k,4);
  70.   until keypressed;
  71.   clearkeybuf;
  72.   freemem(virscr,64000);
  73.  
  74.   { zoom in - with right and bottom clipping! }
  75.   destenation:=vidptr; { destenation is now visual screen }
  76.   cls(vidptr,64000);
  77.   i:=1; j:=1;
  78.   repeat
  79.     scalepic(pcxpic,320,200,0,0,i,j);
  80.     inc(i,3); inc(j);
  81.   until keypressed or (j>200);
  82.   waitkey(5);
  83.  
  84.   { mirror to four directions }
  85.   cls(vidptr,64000);
  86.   scalepic(pcxpic,320,200,0,0,150,90);
  87.   scalepic(pcxpic,320,200,310,0,160,90);
  88.   scalepic(pcxpic,320,200,0,190,150,100);
  89.   scalepic(pcxpic,320,200,310,190,160,100);
  90.   waitkey(5);
  91.  
  92.   { randomly scale'n'mirror }
  93.   cls(vidptr,64000);
  94.   randomize;
  95.   repeat
  96.     scalepic(pcxpic,320,200,random(320),random(200),random(320),random(200));
  97.   until keypressed;
  98.   waitkey(1);
  99.  
  100.   freemem(pcxpic,64000);
  101.   setvideo(u_lm);
  102. end.
  103.